perm filename TEKBAS.SAI[PIC,HE] blob
sn#430352 filedate 1979-04-04 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00003 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 ENTRY tekbox,TEKREG,TEKEND,TEKLIN
C00006 00003 INTERNAL PROCEDURE TEKREG(INTEGER MSKBUF STRING LABBEL REAL MPLIER)
C00009 ENDMK
C⊗;
ENTRY tekbox,TEKREG,TEKEND,TEKLIN;
BEGIN "TEKBAS"
REQUIRE "36A" COMPILER!SWITCHES;
REQUIRE "VISLIB.SAI" SOURCE!FILE;
COMMENT DEFINE TENEX="TRUE";
DEFINE TENEX="FALSE";
IFCR TENEX THENC
SOURCE!V(XGPDEC);
SOURCE!V(GRAPH.DCL);
SOURCE!B(SEG.DCL);
SOURCE!B(SSEG.DCL);
SOURCE!(<BABU>APAR.DCL);
DEFINE APARDATA="EXTERNAL";
SOURCE!(<BABU>APAR.DATA);
SOURCE!(<BABU>SAP.DCL);
EXTERNAL INTEGER IMGTEK;
EXTERNAL STRING FILE1;
ENDC
INTEGER PROCEDURE TEKBORDER(INTEGER IBUF,II,JJ; STRING LABBEL; real mplier);
BEGIN "TEKBORDER"
IFCR TENEX THENC
SAFE INTEGER ARRAY NEIGHBORS[0:7];
INTEGER RWS,COLS,I,J,N,ST,TEMP,MLI,MLJ;
RWS←ROWS(IBUF); COLS←COLMS(IBUF);
MLI←ISUBST(IBUF)-1; MLJ←JSUBST(IBUF)-1;
I←II; J←JJ;
ST←0;
IF LENGTH(LABBEL) THEN IF IMGTEK THEN LDXSTR(LABBEL,DUM←MPLIER*(I+MLI+2),ZILCH←MPLIER*(J+MLJ+2))
ELSE STRAT(LABBEL,I+MLI,J+MLJ);
IF (DUM←BDRPRE(N,I,J,IBUF,RWS,COLS,NEIGHBORS))≤0 THEN RETURN(DUM);
IF IMGTEK THEN BEGIN DUM←I+MLI-1; ZILCH←J+MLJ-1 END
ELSE POINTA(RDUM←I+MLI,RZILCH←J+MLJ);
WHILE TRUE DO
BEGIN "LOOP"
TEMP←(N+ST) MOD 8;
I←I+ICASEV(TEMP);
J←J+JCASEV(TEMP);
IF IMGTEK THEN DRWVEC(MPLIER*DUM,MPLIER*ZILCH,MPLIER*(DUM←I+MLI-1),MPLIER*(ZILCH←J+MLJ-1))
ELSE DRAWA(RDUM←I+MLI,RZILCH←J+MLJ);
IF I=II AND J=JJ THEN RETURN(TRUE);
BDRPOST(N,ST,TEMP,I,J,IBUF,RWS,COLS,NEIGHBORS);
END "LOOP";
ENDC
END "TEKBORDER";
simple internal procedure tekbox(integer rrval,ccval; string labbel; real mplier);
begin
real rmin,rmax,cmin,cmax;
rmin←lhalf(rrval); rmax←rhalf(rrval);
cmin←lhalf(ccval); cmax←rhalf(ccval);
if imgtek
then begin
RMIN←RMIN*MPLIER-1; RMAX←RMAX*MPLIER-1; CMIN←CMIN*MPLIER-1; CMAX←CMAX*MPLIER-1;
IF LENGTH(LABBEL) THEN IF IMGTEK THEN LDXSTR(LABBEL,DUM←rmin+4,ZILCH←cmin+4);
drwvec(rmin,cmin,rmax,cmin);
drwvec(rmin,cmin,rmin,cmax);
drwvec(rmin,cmax,rmax,cmax);
drwvec(rmax,cmax,rmax,cmin)
end
else begin
IF LENGTH(LABBEL) THEN STRAT(LABBEL,rmin+2,cmin+2);
pointa(rmin,cmin);
drawa(rmax,cmin);
drawa(rmax,cmax);
drawa(rmin,cmax);
drawa(rmin,cmin)
end;
end;
INTERNAL PROCEDURE TEKREG(INTEGER MSKBUF; STRING LABBEL; REAL MPLIER);
BEGIN
INTEGER NUM,SI,SJ;
UPTOVAL(SI←1,SJ←1,1,MSKBUF);
TEKBORDER(MSKBUF,SI,SJ,LABBEL,MPLIER);
END;
OWN INTEGER TCALLED;
SIMPLE INTERNAL PROCEDURE TEKEND;
BEGIN
TCALLED←0;
SGCLOSE; SSGRCLOSE;
APARCLOSE; SAPRCLOSE;
END;
INTERNAL PROCEDURE TEKLIN(INTEGER ASIZ; STRING LABBEL,TLFILE; INTEGER TSCAL,SAPID);
BEGIN "TEKLIN"
IFCR TENEX THENC
INTEGER SEGLEN,II,REDF;
REAL OR2,OC2,RS,CS;
EXTERNAL STRING PICTURE;
IF TCALLED=0
THEN BEGIN "SETUPFIRSTCALL"
IF LENGTH(TLFILE) THEN PICTURE←TLFILE ELSE SPRMPT("EDGE FILE",PICTURE);
SGRDOPEN;
SSGRDOPEN;
APARDOPEN;
SAPRDOPEN;
IF TSCAL=0 THEN IPRMPT("REDUCTION FACTOR",REDF←1) ELSE REDF←TSCAL;
TCALLED←-1;
END "SETUPFIRSTCALL";
SAPINID(SAPID);
BEGIN "DRWSAPLIN"
SAFE INTEGER ARRAY APARR[1:(SEGLEN←NAPINSAP)];
GETAPS(APARR);
SETSS(SAPFAMILY);
OR2←OC2←0.0;
FOR II←1 STEP 1 UNTIL SEGLEN DO
BEGIN
APARIN(APARR[II]);
GETBEG(APARR[II],DUM,ZILCH);
RS←DUM/REDF;
CS←ZILCH/REDF;
IF OR2≠0 OR OC2≠0
THEN IF IMGTEK THEN DRWVEC(OR2-1,OC2-1,RS-1,CS-1)
ELSE BEGIN
POINTA(OR2,OC2);
DRAWA(RS,CS);
END;
GETEND(APARR[II],DUM,ZILCH);
OR2←DUM/REDF;
OC2←ZILCH/REDF;
IF IMGTEK THEN DRWVEC(RS-1,CS-1,OR2-1,OC2-1)
ELSE BEGIN
POINTA(RS,CS);
DRAWA(OR2,OC2);
END;
IF II=1 AND LENGTH(LABBEL) THEN IF IMGTEK THEN LDXSTR(LABBEL,DUM←(RS+2),ZILCH←(CS+2)) ELSE STRAT(LABBEL,RS,CS);
END;
END "DRWSAPLIN";
ENDC
END "TEKLIN";
END